home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tpsqapi1.zip
/
MSGTOSQ.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-02-13
|
5KB
|
193 lines
{$A-,R-,O+}
unit MSGToSq;
(*
This unit will take a SDM message and rearrange it, and store it
in a SQUISH FILE.
*)
interface
uses
Squish,
fidofmt;
function SDMToSQD(
mname,
sname: String;
var mh : _fidoMsgType;
var newnum : word;
lockit : boolean
): Integer;
procedure ArrangeTxt(var msg: MsgBufPtrType; var msiz, csiz: LongInt);
implementation
(*
Function, given ptr to buffer and size , will arrange the control info
and message test, and return the new sizes for both sections
*)
procedure ArrangeTxt(var msg: MsgBufPtrType; var msiz, csiz: LongInt);
var
mpos,
cpos: Word;
tsize : word;
begin
mpos := 0;
cpos := 0;
tsize := msiz;
while (msg^[mpos] = #10) do Inc(mpos);
while (msg^[mpos] = #1) do
begin
if (mpos > cpos) then
begin
Move(msg^[mpos],msg^[cpos],msiz - mpos);
Dec(msiz,mpos - cpos);
cpos := mpos
end;
while (not (msg^[cpos] in [#0,#13])) do Inc(cpos);
if (msg^[cpos] = #13) then
begin
msg^[cpos] := #0;
mpos := cpos + 1;
while (msg^[mpos] = #10) do Inc(mpos)
end
else mpos := cpos
end;
if (msg^[msiz] <> #0) then msg^[msiz] := #0;
csiz := 0;
if (msg^[0] = #1) then
begin
while (msg^[csiz] <> #0) do Inc(csiz);
Inc(csiz)
end;
if (csiz = 0) then
begin
Move(msg^[csiz],msg^[csiz+1],msiz);
Inc(msiz);
msg^[0] := #0;
csiz := 1
end
end;
(* Convert "*.MSG" header to Squish message header *)
procedure SdmToSqMHdr(var mh: _fidomsgtype; var sh: _SqMHdrtype);
begin
FillChar(sh,SizeOf(_SqMHdrtype),#0);
Move(mh.towhom, sh.towhom, 36);
Move(mh.from, sh.fromwhom,36);
Move(mh.subject, sh.subj,72);
Move(mh.azdate, sh.azdate,20);
sh.orig.zone := 0;
sh.dest.zone := 0;
sh.orig.net := mh.orig_net;
sh.dest.net := mh.dest_net;
sh.orig.node := mh.orig_node;
sh.dest.node := mh.dest_node;
sh.attr := mh.attr;
sh.date_written := mh.date_written;
sh.date_arrived := mh.date_arrived;
sh.replyto := mh.reply
end;
function SDMToSQD(
mname,
sname: String;
var mh : _fidoMsgType;
var newnum : word;
lockit : boolean
): Integer;
var
mb: MsgBufPtrType;
fo,
fz,
mz,
cz: LongInt;
sb: _SqBasetype;
sf: _SqFHdrType;
sm: _SqMHdrType;
si: _SqIdxType;
rc: Integer;
fi,
fd: File;
msize : longint;
begin
rc := SDMRead(mname,mh,mb,msize);
if (rc = 0) then
begin
mz := msize;
ArrangeTxt(mb,mz,cz);
Inc(mz,_SQMSIZE);
rc := SqOpenSQD(sname,fd,Lockit);
if (rc = 0) then
begin
rc := SqReadBHdr(fd,sb);
if (rc = 0) then
begin
fz := mz;
rc := SqNewFrame(fd,sb,sf,fz,fo);
if (rc = 0) then
begin
sf.frame_length := fz;
sf.msg_length := mz;
sf.clen := cz;
if (sf.frame_length = 0) then
begin
sf.frame_length := sf.msg_length;
sb.end_frame := fo + _SQFSIZE + _SQMSIZE + sf.frame_length
end;
rc := SqWriteFHdr(fd,sf,fo);
if (rc = 0) then
begin
SDMToSqMHdr(mh,sm);
rc := SqWriteMHdr(fd,sm,fo);
if (rc = 0) then
begin
rc := SqWriteMTxt(fd,mb^,fo,mz);
if (rc = 0) then
begin
si.ofs := fo;
si.umsgid := sb.uid;
si.hash := SqAzHashName(sm.towhom);
Inc(sb.num_msg);
sb.high_msg := sb.num_msg;
Inc(sb.uid);
rc := SqWriteBHdr(fd,sb);
if (rc = 0) then
begin
rc := SqOpenSQI(sname,fi);
if (rc = 0) then
begin
rc := SqWriteSqI(fi,si,sb.num_msg-1);
rc := SqCloseSQI(fi);
newnum := sb.num_msg;
end
end
end
end
end
end
end;
rc := SqCloseSQD(fd)
end
end;
if mb <> nil then FreeMem(mb,msize);
SDMToSQD := rc
end;
end.